home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Meeting Pearls 4
/
Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso
/
Pearls
/
midi
/
misc
/
Midi2TeX
/
src
/
tp_m2t13.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-11-30
|
111KB
|
3,094 lines
{$R+,S+,D+,F+}
{$DEFINE PC} (* activate for DOS machines *)
{ $DEFINE ST} (* activate for ST machine *)
program TP_M2T13;
(******************************************************************)
(* Deze versie is voor MusicTeX *)
(* *)
(* *)
(* 19-5-92 *)
(******************************************************************)
uses TP_M2TF2,
DOS,
Printer,
{$IFDEF ST}
GemAES,
{$ENDIF}
TP_Decl,
TP_Misc,
TP_Heap1,
TP_debug,
TP_MIDI;
(*************************************************************)
Procedure NewErrorExit;
(*************************************************************)
Begin
If ExitCode>0 Then
Begin
If MIDIFileOpened Then
WriteLn(TexFile,'% MIDI2TeX processing ended due to runtime error');
ToBothEr(' Wait a minute, this was a runtime error, of type : '+I2S(ExitCode));
End;
If MidiFileOpened Then
Begin
Close(MidiFile);
Close(TexFile);
(* FreeMem(TexBuf,SizeOf(BufType)); this seems to be not necessary *)
WriteDebugInfo('Closing Midi & Tex File...');
End;
If DebugFileOpened Then
Begin
Close(DebugFile);
(* FreeMem(DebBuf,SizeOf(BufType)); this seems to be not necessary *)
If Debug Then WriteLn('Closing up Debugging logger...');
End;
KillNotePool;
KillNoteLists;
For i:=1 To NoTracks Do
KillFilRec(TrackArray[i].FilRec);
{$IFDEF ST}
If NOT BatchProcessing then
Begin
WriteLn('Hit key to exit');
Repeat until KeyPressed;
End;
{$ENDIF}
ExitProc:=OldExitProc;
End; (* NewErrorExit *)
(*************************************************************)
Procedure InstallNewErrorExit;
(*************************************************************)
Begin
OldExitProc:=ExitProc;
ExitProc:=@NewErrorExit;
End; (* InstallNewErrorExit *)
(*************************************************************)
Function CheckChordNotes(Note1,Note2:NoteRecord):Boolean;
(* *)
(* This function checks if notes 1 and 2 form a chord *)
(*************************************************************)
CONST eps=3;
Begin
Case TimeDiff(Note1.StartTime,Note2.StartTime) OF
-eps..eps : If Note1.NoteType=Note2.NoteType Then
CheckChordNotes:=TRUE
Else
CheckChordNotes:=FALSE;
Else
CheckChordNotes:=FALSE;
End; (* case *)
End; (* CheckChordNotes *)
(********************************************************)
Function NoteLength(ThisNote : NoteRecord):LongInt;
(********************************************************)
Begin
With ThisNote DO NoteLength:=TimeDiff(EndTime,StartTime);
End;
(**************************************************************)
Procedure ResetChordArray(VAR ThisStack : ChordArrayType);
(*************************************************************)
Begin
FillChar(ThisStack,SizeOf(ChordArrayType),0);
End;
(**************************************************************)
Procedure ResetBeamArray(VAR ThisArray : BeamArrayType);
(*************************************************************)
Begin
FillChar(ThisArray,SizeOf(BeamArrayType),0);
End;
(**************************************************************)
Procedure ResetAccKeys;
(*************************************************************)
Var i : Integer;
Begin
For i:=1 to ntracks do
With TrackArray[i] Do FillChar(AccKey,SizeOf(AccKeyType),0);
End;
(******************************************************)
Procedure SortChord(VAR ThisTrack: TrackRecord;
VAR ThisChord: ChordRecord);
(******************************************************)
VAR mn,mx,k,mean : Integer;
N,P,Nmx,Nmn : NoteRecPoint;
Border : Integer;
Begin
mn:=32000; mx:=0; mean:=0; k:=0;
With ThisTrack Do
Begin
N:=ThisChord.StartNote;
NextNote(ThisChord.EndNote,P);
Repeat
Inc(mean,N^.NoteVal);
Inc(k);
if N^.NoteVal>mx Then
Begin mx:=N^.NoteVal; Nmx:=N; End;
if N^.NoteVal<mn Then
Begin mn:=N^.NoteVal; Nmn:=N; End;
NextNote(N,N);
until N=P;
mean:=mean div k;
Case ThisTrack.Clef Of
VIOLIN : Border:=70;
BASS : Border:=52 ;
End;
if mean>Border then (* put lowest last , staff should be down *)
Begin
If (ThisCHord.EndNote<>Nmn) Then
Begin
WriteDebugInfo('Exchanging note '+B2S(ThisCHord.EndNote^.NoteVal)+' with '+B2S(Nmn^.NoteVal));
With ThisCHord Do If STartNote=Nmn Then StartNote:=EndNote; (* else ???*)
Exchange(NoteList,Nmn,ThisChord.EndNote);
ThisChord.EndNote^.CHordNote:=TRUE;
Nmn^.ChordNote:=FALSE;
Nmn^.Orient:=DOWN;
ThisChord.EndNote:=Nmn;
End
Else
WriteDebugInfo('No sort necessary')
End
Else (* put highest note last, staff should be up *)
Begin
If (ThisCHord.EndNote<>Nmx) Then
Begin
WriteDebugInfo('Exchanging note '+B2S(ThisCHord.EndNote^.NoteVal)+' with '+B2S(Nmx^.NoteVal));
With ThisCHord Do If STartNote=Nmx Then StartNote:=EndNote;
Exchange(NoteList,Nmx,ThisChord.EndNote);
ThisChord.EndNote^.CHordNote:=TRUE;
Nmx^.ChordNote:=FALSE;
Nmx^.Orient:=UP;
ThisChord.EndNote:=Nmx;
End
Else
WriteDebugInfo('No sort necessary');
End;
End; (* with thistrack *)
End; (* SortChord *)
(******************************************************)
Procedure ChordFind(VAR ThisTrack: TrackRecord);
(******************************************************)
CONST
eps = 0.1;
VAR
dstart : LongInt;
VoidNotes: Byte;
N,P,Q : NoteRecPoint;
Chording : Boolean;
Begin
WriteDebugInfo('Starting ChordFind');
Chording:=FALSE;
With ThisTrack Do
Begin
ChStackPoint:=1;
ChStackEnd:=1;
VoidNotes:=0;
FirstNote(NoteList,N);
FirstNote(NoteList,P);
Repeat
Begin
CASE N^.Event Of
REST : Begin (* this should end any pending chords *) end;
VOID : INC(VoidNotes);
NOTEON,NOTEOFF :
Begin
If NOT Chording Then
With ChordArray[ChStackPoint] DO
Begin
StartNote:=N;
N^.ChordNote:=TRUE;
NoNotes:=1;
Chording:=TRUE;
End
Else (* if Chording *)
Begin
PrevNote(N,Q);
dstart:=TimeDiff(N^.StartTime,Q^.StartTime);
If (N^.NoteType=Q^.NoteType)
AND (dstart<QuantTime) Then
Begin (* notetypes and starttimes are equal *)
With ChordArray[ChStackPoint] DO
Begin
WriteDebugInfo('Note '+W2S(N^.NoteVal)+' in chord');
N^.ChordNote:=TRUE;
EndNote:=N;
INC(NoNotes);
End;
End
Else
Begin (* note types or starttimes are not equal *)
If ChordArray[ChStackPoint].NoNotes >1 Then
Begin (* there was a chord on the stack *)
WriteDebugInfo('Finishing up a chord..');
ChordArray[ChStackPoint].ChordFinished:=TRUE;
(* start a possible beam at this chord's note *)
WITH ChordArray[ChStackPoint] DO
EndNote^.ChordNote:=FALSE;
INC(ChStackPoint);
WITH ChordArray[ChStackPoint] DO
Begin
N^.ChordNote:=TRUE;
StartNote:=N;
INC(NoNotes);
End;
End
Else
Begin (* there was no chord on the stack *)
WITH ChordArray[ChStackPoint] DO
Begin
StartNote^.ChordNote:=FALSE;
N^.ChordNote:=TRUE;
StartNote:=N;
NoNotes:=1;
End;
End;
End;
End;
End; (* Event=NOTEON,NOTEOFF *)
End; (* End Case *)
NextNote(N,N);
End; (* repeat loop *)
Until N=P; (* FirstNote(NoteList) *)
WriteDebugInfo('Processed all events in the notelist');
Case ChordArray[ChStackPoint].NoNotes of
2..10 :Begin (* finish up chord *)
With ChordArray[ChStackPoint] DO
Begin
ChordFinished:=TRUE;
EndNote^.ChordNote:=FALSE;
End;
ChStackEnd:=ChStackPoint
End;
1 :Begin (* Cancel the one-note-chord *)
With ChordArray[ChStackPoint] Do
Begin
StartNote^.ChordNote:=FALSE;
StartNote:=NIL;
End;
Dec(ChStackPoint);
ChStackEnd:=ChStackPoint
End;
0 :Begin (* there are no notes in the stack *)
Dec(ChStackPoint);
ChStackEnd:=ChStackPoint
End;
END; (* CASE *)
END; (* WITH *)
With ThisTrack Do
Begin
WriteDebugInfo('Resorting '+W2S(ChStackEnd)+' Chord(s) in this measure');
(* WriteDebugInfo('Before sort: '+NoteList2String(NoteList)); *)
WriteDebugInfo('Before sort: '+ChordNoteList2String(NoteList));
For i:=1 To ChStackEnd Do
Begin
SortChord(ThisTrack,ChordArray[i]);
End;
(* WriteDebugInfo('After sort: '+NoteList2String(NoteList)); *)
WriteDebugInfo('After sort: '+ChordNoteList2String(NoteList));
End;
WriteDebugInfo('Number of void notes found in this measure by chordfind:'+B2S(VoidNotes));
WriteDebugInfo('ChordFind ready');
End; (* ChordFind *)
(******************************************************)
function FindSlurrIndex : Integer;
(******************************************************)
VAR i : Integer;
Begin
i:=0;
While (SlurrIndexes[i]) AND (i<MAXSLURR) do INC(i);
If i>=MAXSLURR Then ErrorExit(16);
SlurrIndexes[i]:=TRUE;
FindSlurrIndex:=i;
End;
(*********************************************************)
function IsSlurred(N : NoteRecPoint;
ThisTrack: TrackRecord): Integer;
(******************************************************)
VAR i : Integer;
B : Integer;
Begin
B:=0;
WIth Thistrack Do
Begin
For i:=1 To SlurrPt Do
With SlurrArray[i] Do
If Occupied and (NotePnt=N) Then
B:=i;
End;
IsSlurred:=B;
End;
(********************************************************)
Procedure FindSlurrNote(VAR ThisTrack : TrackRecord;
CurMeasure: Integer);
(********************************************************)
VAR
N,P : NoteRecPoint;
SlurrI1,SlurrI2 :integer;
TmpTime : MeasureTime;
Begin
WriteDebugInfo('Starting SlurrFinder');
SetTime(TmpTime,CurMeasure+1,0);
With ThisTrack DO
Begin
FirstNote(NoteList,N);
P:=N;
Repeat
Begin
With N^ Do
Case Event Of
REST : (* A rest occurred, their ought not to be any slurrs *)
Begin
End;
NOTEON,
NOTEOFF:
If TimeDiff(TmpTime,EndTime)<0 Then
(* The EndTime of this note is beyond the end of current measure *)
(* So, slurr this note *)
Begin
SlurrI2:=IsSlurred(N,ThisTrack);
If SlurrI2=0 Then (* was not already slurred *)
Begin
SlurrI1:=FindSlurrIndex;
Inc(SlurrPt);
With SlurrArray[SlurrPt] Do
Begin
WriteDebugInfo('At note '+B2S(N^.NoteVal)+' a startslurr');
NotePnt:=N;
NoteVal:=N^.NoteVal;
KindOf:=STARTSLUR;
Numb1:=SlurrI1;
Occupied:=TRUE;
End;
Slurring:=TRUE;
(*Slurring:=FALSE;*) (* this disables slurring for test purpose *)
End (* If SlurrI2=0 *)
Else
Begin
(* Note was already slurred. *)
SlurrI1:=FindSlurrIndex;
With SlurrArray[SlurrPt] Do
Begin
WriteDebugInfo('At note '+B2S(N^.NoteVal)+' a repeatslurr');
KindOF:=REPEATSLUR;
Numb2:=Numb1;
Numb1:=SlurrI1;
End;
End;
End
Else
(* The EndTime of this note is in current measure *)
If Slurring Then
Begin
SlurrI2:=IsSlurred(N,ThisTrack);
If SlurrI2>0 Then (* this note was slurred *)
With SlurrArray[SlurrI2] Do
Begin
WriteDebugInfo('At note '+B2S(N^.NoteVal)+' end slurr');
KindOf:=ENDSLUR;
Numb2:=Numb1;
End
End;
End; (* case *)
NextNote(N,N);
End;
Until N=P; (* FirstNote(NoteList) *)
End; (* with TrackList *)
End; (* FindSlurrNote*)
(******************************************************************)
Procedure ChopRest(VAR N: NoteRecPoint;VAR ThisTrack : TrackRecord;
ThisMsre : Integer);
(******************************************************************)
VAR P : NoteRecPoint;
dt : LongInt;
TmpTime : MeasureTime;
DivTime,
divider : word;
cnt : Byte;
Begin
WriteDebugInfo('Starting ChopRest ');
SetTime(TmpTime,ThisMsre+1,0);
dt:=TimeDiff(N^.EndTime,TmpTime);
if dt>0 Then (* Rest is longer than and of current measure *)
Begin
WriteDebugInfo('Chopping rest off at end of this measure');
P:=GetFreeNote;
Insert(ThisTrack.NoteList,N^.Next,P);
P^.EndTime:=N^.EndTime;
P^.StartTime:=TmpTime; N^.EndTime:=TmpTime;
P^.Event:=REST;
End;
dt:=TimeDiff(N^.EndTime,N^.StartTime);
divtime:=8*PieceCOntr.Division;
cnt:=0;
While dt>4*PieceContr.Division div 32 Do
Begin
Divider:=0;
While Divider=0 Do
Begin
divtime:=divtime SHR 1;
divider:=dt div divtime;
inc(cnt);
End;
SetTime(TmpTime,0,divtime);
AddTime(N^.StartTime,TmpTime,TmpTime);
N^.NoteType:=NoteTypes(cnt);
dt:=dt - Divider*DivTime;
if dt>4*PieceContr.Division div 64 Then
Begin
P:=GetFreeNote;
Insert(ThisTrack.NoteList,N^.Next,P);
P^.Event:=REST;
P^.EndTime:=N^.EndTime;
N^.EndTime:=TmpTime;
P^.StartTime:=TmpTime;
WriteDebugInfo('Chopping rest into: ['+I2S(N^.StartTime.Measure)+':'+LI2S(N^.StartTime.MPart)+'-'
+I2S(N^.EndTime.Measure)+':'+LI2S(N^.EndTime.MPart)+']and ['
+I2S(P^.StartTime.Measure)+':'+LI2S(P^.StartTime.MPart)+'-'
+I2S(P^.EndTime.Measure)+':'+LI2S(P^.EndTime.MPart)+']');
N:=P;
End;
End; (* while *)
WriteDebugInfo('End ChopRest');
End; (* ChopRest *)
(******************************************************)
Procedure FindNoteTypes(VAR ThisTrack : TrackRecord;
ThisMsre : Integer);
(******************************************************)
VAR
N,P : NoteRecPoint;
dt : Longint;
Divisor,
Rst : Integer;
SlurrI1,SlurrI2:integer;
TmpTime : MeasureTime;
Begin
With ThisTrack DO
Begin
FirstNote(NoteList,N);
P:=N;
Repeat
Begin
With N^ Do
Begin
Case Event Of
NOTEON,NOTEOFF : Case Clef Of
VIOLIN : If NoteVal>70 Then Orient:=DOWN Else Orient:=UP;
BASS : If NoteVal>52 Then Orient:=DOWN Else Orient:=UP;
End;
End;
Case Event Of
NOTEON :
Begin
WriteDebugInfo('Found a non-closed note');
WriteDebugInfo('Starting at '+W2S(StartTime.Measure)+':'+
W2S(StartTime.MPart));
WriteDebugInfo('Ending at '+W2S(EndTime.Measure)+':'+
W2S(EndTime.MPart));
(* this prevent that the endtimes (1000) of non-closed notes *)
(* faul up the selection of the notetype *)
SetTime(TmpTime,ThisMsre+1,0);
End;
Else
Begin
(* if the note ends in this measure, check if its length is *)
(* longer than a whole note *)
(* check if a noteoff is shut off in this measure *)
SetTime(TmpTime,ThisMsre+1,0);
dt:=TimeDiff(TmpTime,EndTime);
if dt>=0 Then (* Note is closed in this measure ... *)
TmpTime:=EndTime;
End;
End; (* case *)
If Quantizing Then Quantize(N);
(* DO not use EndTime but the previously defined TmpTime *)
dt:=TimeDiff(TmpTime,StartTime);
if dt<0 Then
WriteDebugInfo('Found an event with neg length !');
If dt>0 Then
With PieceContr DO
If Division>dt Then
Begin
Divisor:=Division div dt;
Rst:=10*(Division mod dt) div dt;
Case Divisor OF
1 : Case Rst OF
0..2 : Notetype:=Q;
3,4 : NoteType:=CP;
5..9 : NoteType:=C;
End;
2 : Case Rst OF
0..4 : NoteType:=C;
5..8 : NoteType:=CCP;
9 : NoteType:=C3;
End;
3 : Case Rst OF
0..4 : (* 1/8 trioler *)
NoteType:=C3;
5..9 : NoteType:=CC;
End;
4 : NoteType:=CC;
5,6 : (* 1/16 trioler *)
NoteType:=CC3;
7..12 : NoteType:=CCC;
Else NoteType:=CCCC;
End;
End
Else (* if Division<dt *)
Begin
Divisor:=dt div Division;
Rst:=10*(dt mod Division ) div Division;
Case Divisor Of
1 : Case Rst OF
0..1 : NoteType:=Q;
2..3 : (* These notes should be slurred *)
NoteType:=QPP;
4..6 : NoteType:=QP;
7,8 : NoteType:=QP; (* should be longer *)
9 : NoteType:=H;
End;
2 : Case Rst OF (* dit klopt nog niet ... *)
0..1 : NoteType:=H;
2..3 : NoteType:=HPPP;
4..6 : NoteType:=HPP;
7,8 : NoteType:=HP;
9 : NoteType:=HP;
End;
3 : Case Rst OF
0..4 : NoteType:=HP;
5..9 : NoteType:=WH;
End;
4 : Case Rst OF
0..3 : NoteType:=WH;
4..9 : NoteType:=WHPP;
End;
5 : NoteType:=WHPP;
6 : NoteType:=WHP;
End;
End
Else
Begin
(* Do not show note, it has length zero ! *)
If Event=TXT Then
WriteDebugInfo('Hey, here is that metatext again..')
Else
Begin
Event:=VOID;
WriteDebugInfo('Found a void note');
End;
End;
(* If Event=REST Then ChopRest(N,ThisTrack,ThisMsre); *)
End; (* WIth N^ *)
NextNote(N,N);
End;
Until N=P; (* FirstNote(NoteList) *)
End; (* with TrackList *)
End; (* FindNoteTypes *)
(*********************************************************************)
Function NoteInChord(N:NoteRecPoint;ThisTrack:TrackRecord):Integer;
(*********************************************************************)
VAR i : Byte;
Begin
NoteInChord:=0;
With ThisTrack DO
For i:=1 to ChStackEnd Do
If ChordArray[i].StartNote=N Then NoteInChord:=i;
End;
(******************************************************)
Procedure BeamFind(VAR ThisTrack : TrackRecord);
(******************************************************)
VAR
BeamPnt : Byte;
NotePnt,
FirstPnt,
LastPnt : NoteRecPoint;
Beaming : Boolean;
(*--------------------*)
Procedure StartBeam;
(*--------------------*)
Begin
With ThisTrack.BeamArray[BeamPnt] Do
Begin
StartNote:=NotePnt;
EndNote:=NotePnt;
NoteType:=NotePnt^.NoteType;
Beaming:=TRUE;
NoNotes:=1;
Numb:=BeamIndex;
Inc(BeamIndex);
WriteDebugInfo('Starting beam '+B2S(Numb)+' at note '+B2S(NotePnt^.NoteVal)+
' of type '+B2S(Ord(NoteType)));
End;
End;
(*--------------------*)
Procedure EndBeam;
(*--------------------*)
VAR mn,i : word;
cnt,BPnt,
max,min : Byte;
N,P : NoteRecPoint;
GoOn : Boolean;
Begin
With ThisTrack.BeamArray[BeamPnt] Do
Begin
Beaming:=FALSE;
Chain2Next:=FALSE;
End;
mn:=0; Max:=0; Min:=127; cnt:=0; BPnt:=BeamPnt;
(* Pitch and slope should be determined over all chained beams *)
(* first, from the top find the first beam which has CHain2Next flag set *)
GoOn:=FALSE;
If BPnt>1 Then Dec(Bpnt);
While NOT GoOn Do
Begin
If (ThisTrack.BeamArray[BPnt].Chain2Next) AND (BPnt>1) Then Dec(BPnt)
Else Begin
If (NOT ThisTrack.BeamArray[BPnt].Chain2Next) Then
If (Bpnt<BeamPnt) Then Inc(Bpnt);
GoOn:=TRUE;
End;
End;
(* The first Chain2Next Beam is pointed to by BPnt *)
(* We now have to process all the notes in the beams until BPnt=BeamPnt *)
For i:=Bpnt To BeamPnt Do
Begin
With ThisTrack.BeamArray[i] Do
Begin
N:=StartNote;
NextNote(EndNote,P);
Repeat
Begin
(*If NOT N^.ChordNote Then*)
Case N^.Event Of
NOTEON,NOTEOFF :
Begin
mn:=mn+N^.NoteVal;
inc(cnt);
If N^.NoteVal>Max Then Max:=N^.NoteVal;
If N^.NoteVal<Min Then Min:=N^.NoteVal;
End;
End; (* case *)
NextNote(N,N);
End;
until N=P;
End; (* With *)
End; (* For *)
(* mn,cnt,Max and Min now have values calculated over all Chained beams *)
(* We now have to fill the first beam record (Bpnt) with these values *)
(* This routine now does not take in account the orient of the note *)
(* itself set by FindNotes and ChordFind. Look at this again... *)
(* When handling chords, the mean only sees single notes of the chord.*)
(* So that messes up a lot. *)
With ThisTrack.BeamArray[Bpnt] Do
Begin
mn:=mn Div cnt;
Case ThisTrack.Clef Of
VIOLIN : If mn<70 Then Orient:=UP Else Orient:=DOWN;
BASS : If mn<52 Then Orient:=UP Else Orient:=DOWN;
End;
If ORIENT=UP Then Pitch:=Max ELse Pitch:=Min;
If EndNote^.NoteVal>StartNote^.NoteVal Then
Slope:=(Max-Min) div cnt
Else
Slope:=-(Max-Min) div cnt;
(* WriteDebugInfo('Beam '+B2S(BeamPnt)+' has pitch '+B2S(Pitch)+
',max='+B2S(max)+' min='+B2S(min)); *)
If Orient=UP Then
WriteDebugInfo('Ending beam '+B2S(Numb)+', beam is UP')
Else
WriteDebugInfo('Ending beam '+B2S(Numb)+', beam is DOWN');
End; (* with thistrack.beamarray *)
(* Now Pitch,Orient & Slope must be copied to all Chained beams *)
For i:=BPnt+1 To BeamPnt Do
Begin
ThisTrack.BeamArray[i].Orient:=ThisTrack.BeamArray[i-1].Orient;
ThisTrack.BeamArray[i].Slope:=ThisTrack.BeamArray[i-1].SLope;
ThisTrack.BeamArray[i].Pitch:=ThisTrack.BeamArray[i-1].Pitch;
End;
INC(BeamPnt);
If BeamPnt>MAXBEAMS Then ErrorExit(18);
End;
(*--------------------*)
Procedure CancelBeam;
(*--------------------*)
Begin
Beaming:=FALSE;
With ThisTrack.BeamArray[BeamPnt] Do
Begin
StartNote:=NIL;
EndNote:=NIL;
NoNotes:=0;
WriteDebugInfo('Canceling beam '+B2S(Numb)+' at note '+B2S(NotePnt^.NoteVal));
End;
End;
(*--------------------*)
Procedure QuitBeam;
(*--------------------*)
(* Close up the beams. Cancel Beam only if previous beam *)
(* has Chain2Next flag not set OR if BeamPnt=1 *)
Begin
With ThisTrack Do
If BeamArray[BeamPnt].NoNotes=1 Then
Begin
If BeamPnt=1 Then
CancelBeam
Else If BeamArray[BeamPnt-1].Chain2Next Then
EndBeam
Else CancelBeam
End
Else
EndBeam;
End; (* QuitBeam *)
(*--------------------*)
Procedure Add2Beam;
(*--------------------*)
Begin
With ThisTrack.BeamArray[BeamPnt] Do
Begin
Inc(NoNotes);
EndNote:=NotePnt;
End;
End;
(*--------------------------*)
Procedure CreateUpChainBeam;
(*--------------------------*)
Begin
With ThisTrack.BeamArray[BeamPnt] Do
Begin
Chain2Next:=TRUE;
EndNote:=NotePnt;
End;
INC(BeamPnt);
If BeamPnt>MAXBEAMS Then ErrorExit(18);
With ThisTrack.BeamArray[BeamPnt] Do
Begin
StartNote:=NotePnt;
EndNote:=NotePnt;
NoteType:=NotePnt^.NoteType;
Numb:=BeamIndex-1;
Beaming:=TRUE;
NoNotes:=1;
WriteDebugInfo('Chain beam '+B2S(Numb)+' at note '+B2S(NotePnt^.NoteVal)+
' to type '+B2S(Ord(NoteType)));
End;
End; (* CreateUpChainBeam *)
(*--------------------------*)
Procedure CreateDnChainBeam;
(*--------------------------*)
Begin
With ThisTrack.BeamArray[BeamPnt] Do
Begin
Chain2Next:=TRUE;
End;
INC(BeamPnt);
If BeamPnt>MAXBEAMS Then ErrorExit(18);
With ThisTrack.BeamArray[BeamPnt] Do
Begin
StartNote:=NotePnt;
EndNote:=NotePnt;
NoteType:=NotePnt^.NoteType;
Numb:=BeamIndex-1;
Beaming:=TRUE;
NoNotes:=1;
WriteDebugInfo('Chain beam '+B2S(Numb)+' at note '+B2S(NotePnt^.NoteVal)+
' to type '+B2S(Ord(NoteType)));
End;
End; (* CreateDnChainBeam *)
Begin (* BeamFind *)
WriteDebugInfo('Starting BeamFind');
BeamPnt:=1;
Beaming:=FALSE;
With ThisTrack DO
Begin
FirstNote(NoteList,NotePnt);
FirstPnt:=NIL; (* prevent early termination *)
While NotePnt<>FirstPnt DO
Begin (* while *)
FirstNote(NoteList,FirstPnt);
CASE NotePnt^.Event OF
NOTEON,NOTEOFF:
If NOT NotePnt^.ChordNote Then (* exclude non-spacing notes *)
Begin
WriteDebugInfo('Note '+B2S(NotePnt^.NoteVal)+' is of type '+
B2S(Ord(NotePnt^.NoteType)));
If Beaming Then
Case BeamArray[BeamPnt].NoteType Of
CPPP..C : Case NotePnt^.NoteType Of
CC3..CCCC : CreateUpChainBeam;
CPPP..C : Add2Beam;
Else
QuitBeam;
End;
CC3..CC : Case NotePnt^.NoteType Of
CPPP..C : CreateDnChainBeam;
CCC3..CCCC : CreateUpChainBeam;
CC3..CC : Add2Beam;
Else
QuitBeam;
End;
CCC3..CCC : Case NotePnt^.NoteType Of
CPPP..CC : CreateDnChainBeam;
CCCC3..CCCC : CreateUpChainBeam;
CCC3..CCC : Add2Beam;
Else
QuitBeam;
End;
CCCC3..CCCC3: Case NotePnt^.NoteType Of
CPPP..CCC : CreateDnChainBeam;
CCCC3..CCCC3: Add2Beam;
Else
QuitBeam;
End;
Else
QuitBeam;
End (* Case under If Beaming *)
Else
Begin (* not Beaming *)
If NotePnt^.NoteType>CPP Then
StartBeam;
End; (* not Beaming *)
End; (* NOTEON,NOTEOFF *)
End; (* CASE N^.Event OF *)
NextNote(NotePnt,NotePnt);
End; (* WHILE *)
End; (* with thistrack *)
If Beaming Then QuitBeam;
WriteDebugInfo('BeamFind Ready');
End; (* BeamFind *)
(**********************************************)
Procedure InitFilePosns(N:Integer);
(**********************************************)
VAR i,dummy : Byte;
cnt,
NoOfBytes,
OldPos : LongInt;
TmpStr : String;
Begin
i:=1;
(* OldPos:=FilePos(MidiFile); *)
repeat
TmpStr:=ReadString(HlpFilRec,4);
WriteDebugInfo(' Found start of track '+B2S(i)+' with name:'+TmpStr);
NoOfBytes:=ReadLongInt(HlpFilRec);
(*WriteDebugInfo('FIlePos:'+LI2S(GetFilePos(HlpFilRec))); *)
WriteDebugInfo(LI2S(NoOfBytes)+' bytes in this track');
With TrackArray[i] DO
Begin
(* Copy the file info stuff into the currentr track file info *)
FilRec.FilePosition:=HlpFilRec.FilePosition;
Move(HlpFilRec.ReadBuf^,FilRec.ReadBuf^,BufSize);
EndOfTrackRead:=FALSE;
FilRec.BytesProcessed:=0;
FilRec.BufSemaphore:=HlpFilRec.BufSemaphore;
FilRec.BufPoint:=HlpFilRec.BufPoint;
FilRec.LastBlockRead:=HlpFilRec.LastBlockRead;
SafetyCounter:=0;
FillChar(CurTime,SizeOf(CurTime),0);
FillChar(OldTime,SizeOf(CurTime),0);
End;
For cnt:=1 to NoOfBytes Do dummy:=ReadByte(HlpFilRec);
(*WriteDebugInfo('FIlePos:'+LI2S(GetFilePos(HlpFilRec))); *)
INC(i);
until i=N+1;
(* Seek(MidiFile,OldPos); *)
End; (* InitFilePosns *)
(**********************************************)
Function AllTracksRead(N:integer) : Boolean;
(**********************************************)
VAR b : boolean;
i : integer;
Begin
b:=TRUE;
For i:=1 To N Do
If NOT EndOfTrackReached(TrackArray[i])Then b:=FALSE;
AllTracksRead:=b;
End;
(**********************************************)
Procedure InitFileDebug;
(**********************************************)
Var FilesSel,
Pcnt,i,j: Byte;
PS,S : String;
Sint,
Serr : Integer;
(*--------------------------------------------------------------*)
Procedure ReadFileName(VAR ThisFile : FileNameType; path : String);
(*--------------------------------------------------------------*)
Begin
With ThisFile Do
Begin
p:=path;
Fsplit(p,d,n,e);
If e='' Then
If FilesSel=0 Then e:='.MID' Else e:='.TEX';
p:=d+n+e;
INC(FilesSel);
End;
End; (* ReadFileName *)
(*--------------------------------------------------------------*)
Function SplitHead(VAR PS : String) : integer;
(*--------------------------------------------------------------*)
VAR j,Sint,Serr : Integer;
S : String[3];
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then SplitHead:=Sint Else SplitHead:=-1;
End; (* SplitHead *)
Begin
FilesSel:=0;
DebugOut:=NODEB;
Debug:=FALSE;
For PCnt:=1 To ParamCount Do
Begin
(* WriteLn('Paramstring=',ParamStr(PCnt)); *)
PS:=ParamStr(PCnt);
If Copy(PS,1,1)='-' Then
Begin
If Copy(PS,1,2)='-?' Then
Begin
ErrorExit(0);
End;
{$IFDEF ST}
If Copy(PS,1,2)='-x' Then
Begin
BatchProcessing:=TRUE;
End;
{$ENDIF}
If Copy(PS,1,2)='-i' Then
Begin (* determine instrument staffs *)
If (ninstruments>0) Then ErrorExit(14);
INC(ninstruments);
Delete(PS,1,2);
IF Length(PS)<3 Then ErrorExit(15);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
TrackArray[Sint].Instrument:=TRUE;
INC(NtracksInInstr);
WriteDebugInfo('Track :'+I2S(Sint)+' is part of an instrument');
End;
End;
End; (* if switch='-i' *)
If Copy(PS,1,2)='-f' Then
Begin (* force zero beams for these staffs *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
TrackArray[Sint].ForceZeroBeams:=TRUE;
WriteDebugInfo('Track :'+I2S(Sint)+' has beam slope forced to zero');
End;
End;
End; (* if switch='-f' *)
If Copy(PS,1,2)='-h' Then
Begin (* change horizontal size *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
ErrorExit(19);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
scorewidth:=Sint;
SizingChanged:=TRUE;
WriteDebugInfo('Changing scorewidth from default to '+I2S(scorewidth));
End;
End;
End; (* if switch='-h' *)
If Copy(PS,1,2)='-v' Then
Begin (* change vertical size *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
ErrorExit(19);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
scoreheight:=Sint;
SizingChanged:=TRUE;
WriteDebugInfo('Changing scoreheight from default to '+I2S(scoreheight));
End;
End;
End; (* if switch='-v' *)
If Copy(PS,1,2)='-e' Then
Begin (* change elemskip value *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
ErrorExit(19);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
Elemskip:=Round(Sint*PT);
SizingChanged:=TRUE;
WriteDebugInfo('Changing Elemskip from default to '+I2S(Elemskip));
End;
End;
End; (* if switch='-e' *)
If Copy(PS,1,2)='-m' Then
Begin (* change magnitude of score *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
ErrorExit(19);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
Case Sint Of
20 : Begin MusicSize:=20;
LineHeight:=160;
ScoreSep:=20;
Indent:=115;
CumLength:=215;
BarIndent:=40;
ElemSkip:=Round(10*PT);
End;
16 : Begin MusicSize:=16;
LineHeight:=125;
ScoreSep:=40;
Indent:=90;
CumLength:=190;
BarIndent:=30;
ElemSkip:=Round(8*PT);
End;
Else ErrorExit(20);
End; (* case *)
SizingChanged:=TRUE;
WriteDebugInfo('Changing magnitude from default to '+I2S(Sint));
End;
End;
End; (* if switch='-m' *)
If Copy(PS,1,2)='-k' Then
Begin (* change keysign of score *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
ErrorExit(19);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
Case Sint Of
-8..8 : Begin
PieceContr.KeySign:=Sint;
End;
Else ErrorExit(21);
End; (* case *)
WriteDebugInfo('Changing keysign to '+I2S(Sint));
End;
End;
End; (* if switch='-k' *)
If Copy(PS,1,2)='-q' Then
Begin (* determine quantization *)
Delete(PS,1,2);
Val(PS,Sint,Serr);
If (Serr=0) AND (Sint<=64) AND (Sint>0) Then
Begin
Quantizing:=TRUE;
QuantTime:=Sint;
End
Else
ErrorExit(13);
End; (* if switch='-q' *)
If Copy(PS,1,2)='-b' Then
Begin (* determine bass clefs *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
TrackArray[Sint].Clef:=BASS;
WriteDebugInfo('Track :'+I2S(Sint)+' notated with bass clef');
End;
End;
End; (* if switch='-b' *)
If Copy(PS,1,3)='-a1' Then
Begin (* determine ALTO1 clefs *)
Delete(PS,1,3);
while Length(PS)>0 Do
Begin
Sint:=SplitHead(PS);
If Sint>0 Then TrackArray[Sint].Clef:=ALTO1
Else ErrorExit(22);
WriteDebugInfo('Track :'+I2S(Sint)+' notated with ALTO1 clef');
End;
End; (* if switch='-a1' *)
If Copy(PS,1,3)='-a2' Then
Begin (* determine ALTO2 clefs *)
Delete(PS,1,3);
while Length(PS)>0 Do
Begin
Sint:=SplitHead(PS);
If Sint>0 Then TrackArray[Sint].Clef:=ALTO2
Else ErrorExit(22);
WriteDebugInfo('Track :'+I2S(Sint)+' notated with ALTO2 clef');
End;
End; (* if switch='-a2' *)
If Copy(PS,1,3)='-a3' Then
Begin (* determine ALTO3 clefs *)
Delete(PS,1,3);
while Length(PS)>0 Do
Begin
Sint:=SplitHead(PS);
If Sint>0 Then TrackArray[Sint].Clef:=ALTO3
Else ErrorExit(22);
WriteDebugInfo('Track :'+I2S(Sint)+' notated with ALTO3 clef');
End;
End; (* if switch='-a3' *)
If Copy(PS,1,3)='-a4' Then
Begin (* determine ALTO4 clefs *)
Delete(PS,1,3);
while Length(PS)>0 Do
Begin
Sint:=SplitHead(PS);
If Sint>0 Then TrackArray[Sint].Clef:=ALTO4
Else ErrorExit(22);
WriteDebugInfo('Track :'+I2S(Sint)+' notated with ALTO4 clef');
End;
End; (* if switch='-a4' *)
If Copy(PS,1,2)='-o' Then
Begin (* order staffs *)
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
TrackOrder[OrderIndex]:=Sint;
WriteDebugInfo('Ordering MIDI Track :'+I2S(Sint)+' at Staff '+B2S(OrderIndex));
Inc(OrderIndex);
End;
End;
Dec(OrderIndex) (* now pointing at last item in orderarray *)
End; (* if switch='-o' *)
If Copy(PS,1,2)='-s' Then
Begin
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
If Sint=1 Then
Begin
TrackArray[Sint].Skip:=FALSE;
DEC(NoOfSkips);
End
Else
Begin
Inc(TrackArray[Sint].Skip);
INC(NoOfSkips);
End;
WriteDebugInfo('Skipping Track :'+I2S(Sint));
End
Else
ErrorExit(23);
End;
End; (* skip tracks *)
If Copy(PS,1,2)='-p' Then
Begin
Delete(PS,1,2);
while Length(PS)>0 Do
Begin
j:=Pos(',',PS);
Case j Of
1..10 : Begin
S:=Copy(PS,1,j-1);
Delete(PS,1,j);
End;
Else
S:=Copy(PS,1,Length(PS));
Delete(PS,1,Length(PS));
End; (* case *)
Val(S,Sint,Serr);
If Serr=0 Then
Begin
Case Sint of
1,2,4,8,16,32 : Begin
PieceContr.PartType:=Sint;
WriteDebugInfo('Part Timing ='+I2S(Sint));
PieceContr.PartOverRule:=TRUE;
End;
Else ErrorExit(12);
End;
End;
End;
End; (* PartTime *)
If Copy(PS,1,2)='-d' Then
Begin
If Copy(PS,3,length(PS)-2)='FILE' Then
Begin
If MaxAvail>SizeOf(BufType) Then
GetMem(DebBuf,SizeOf(BufType))
Else
ErrorExit(9);
{$IFDEF PC}
Assign(DebugFile,DebugFileName.p);
ReWrite(DebugFile);
SetTextBuf(DebugFile,DebBuf);
{$ENDIF}
{$IFDEF ST}
ReWrite(DebugFile,DebugFileName.p,BufSize);
{$ENDIF}
DebugFileOpened:=TRUE;
DebugOut:=DEBFILE;
Debug:=TRUE;
End;
If Copy(PS,3,length(PS)-2)='PRINTER' Then
Begin
DebugOut:=PRINT;
Debug:=TRUE;
End;
If Copy(PS,3,length(PS)-2)='SCREEN' Then
Begin
DebugOut:=SCREEN;
Debug:=TRUE;
End;
End;
End (* If this parameter is a switch *)
Else
Begin (* this parameter is not a switch *)
If FilesSel=0 Then
Begin
ReadFileName(MidiFileName,PS);
DebugFileName:=MidiFileName;
With DebugFileName Do
Begin
e:='.MLG';
p:=d+n+e;
End;
End
Else
ReadFileName(TeXFileName,PS);
End; (* else *)
End; (* for next loop *)
If NOT FileExists(MidiFileName.p) Then ErrorExit(1);
If FilesSel=1 Then (* there was no TeXFilename selected *)
Begin
TeXFileName:=MidiFileName;
With TeXFileName do
Begin
e:='.TEX';
p:=d+n+e;
End;
End;
If MaxAvail>SizeOf(BufType) Then
GetMem(TexBuf,SizeOf(BufType))
Else
ErrorExit(9);
{$IFDEF ST}
Reset(MidiFile,MidiFileName.p);
Rewrite(TexFile,TexFileName.p,BufSize);
{$ENDIF}
{$IFDEF PC}
Assign(MidiFile,MidiFileName.p);
Reset(MidiFile,1);
Assign(TexFile,TexFileName.p);
Rewrite(TexFile);
SetTextBuf(TexFile,TexBuf);
{$ENDIF}
MidiFileOpened:=TRUE;
With MIDIFileName Do
Write('Translating ',d+n+e,' into ');
With TeXFileName Do
WriteLn(d+n+e);
WriteDebugInfo('***********************************************');
WriteDebugInfo('* Midi2TeX translator '+Version+' *');
WriteDebugInfo('* by *');
WriteDebugInfo('* Hans Kuykens *');
With MidiFileName Do
WriteDebugInfo('* Translating '+d+n+e);
WriteDebugInfo('* into ');
With TeXFileName Do
WriteDebugInfo('* '+d+n+e);
WriteDebugInfo('***********************************************');
End; (* InitFileDebug *)
(**********************************************)
Procedure Initialize;
(**********************************************)
Begin
MidiFileOpened:=FALSE;
DebugFileOpened:=FALSE;
DebugFileOpened:=FALSE;
InitNotePool;
FillChar(PieceContr,SizeOf(ControlInfo),0);
For i:=1 to NoTracks Do
Begin
FillChar(TrackArray[i],SizeOf(TrackRecord),0);
End;
For i:=1 To NoTracks Do
InitFilRec(TrackArray[i].FilRec);
InitFilRec(HlpFilRec);
For i:=1 To NoTracks Do
TrackOrder[i]:=i;
For i:=0 to MAXSLURR do
SlurrIndexes[i]:=FALSE;
TrackArray[1].SKip:=TRUE; (* Always skip track 1 *)
OrderIndex:=1;
NoOfSkips:=1;
PieceContr.PartOverRule:=FALSE;
Quantizing:=FALSE;
TeXHeaderFinished:=FALSE;
ninstruments:=0;
nTracksInInstr:=0;
ScoreWidth:=1600; (* 0.1 mm *) (* MusicTeX standard *)
ScoreHeight:=2400; (* 0.1 mm *)
LineHeight:=160; (* 0.1 mm *)
ElemSkip:=Round(10*PT); (* 3.5 mm *) (* STandard \elemskip *)
CumLength:=220; (* initialize cumulative length and height *)
Indent:=115;
BarIndent:=40;
ScoreSep:=20;
MeasureMaxCnt:=0; (* Maximum number of notes in a measure *)
MusicSize:=20;
SizingChanged:=FALSE;
BatchProcessing:=FALSE;
NoOfPages:=1;
QuantTime:=16; (* default value *)
InitFileDebug;
End; (* Initialize *)
(*****************************************************)
Procedure CleanUpSlurrArrays;
(*****************************************************)
VAR i,j,TmpIndx : integer;
Begin
TmpIndx:=0;
For j:=1 to ntracks do
With TrackArray[j] do
Begin
i:=1;
While i<=SlurrPt Do
Begin
if NOT SlurrArray[i].Occupied Then (* is processed, remove... *)
Begin
WriteDebugInfo('Removing slurr #'+I2S(SlurrArray[i].Numb2));
SlurrIndexes[SlurrArray[i].Numb2]:=FALSE;
If i<MAXSLURR Then
Begin
Move(SlurrArray[i+1],SlurrArray[i],(MAXSLURR-i)*SizeOf(SlurrRecord));
Dec(i); Dec(SlurrPt); (* dit werkt niet !!! *)
End
Else
Begin
FillChar(SlurrArray[i],SizeOf(SlurrRecord),0);
Dec(SlurrPt);
End
End;
INC(i);
End;
If SlurrPt<0 Then SlurrPt:=0; (* for safety *)
If SlurrPt=0 Then Slurring:=FALSE;
End;
End;
(************************************************************)
Procedure CleanUpTracks;
(************************************************************)
VAR N,P : NoteRecPoint;
All,i : integer;
curtrack : Byte;
TmpTime : MeasureTime;
Begin
SetTime(TmpTime,MeasureCount+1,0);
for curtrack:=1 to ntracks do
With TrackArray[curtrack] Do
Begin
All:=NoteList.Size;
LastNote(NoteList,N);
PrevNote(N,P);
For i:=1 To All Do
Begin
Case N^.Event Of
VOID : Begin
Remove(NoteList,N);
BringFreeNote(N);
End; (* if notearry *)
REST,
NOTEOFF : Begin
If TimeDiff(TmpTime,N^.EndTime)<0 Then
Begin
WriteDebugInfo('Extending event '+B2S(N^.NoteVal)+
' into next measure');
SetTime(N^.StartTime,MeasureCount+1,0);
End
Else
Begin
Remove(NoteList,N);
BringFreeNote(N);
End
End;
NOTEON : SetTime(N^.StartTime,MeasureCount+1,0);
TXT : Begin
FreeMem(N^.MetaTxt,SizeOf(String20Type));
Remove(NoteList,N);
BringFreeNote(N);
End;
PEDAL,
KEYSIGN,
SIGNATURE: Begin
If TimeDiff(TmpTime,N^.StartTime)<0 Then
Begin
WriteDebugInfo('META event '+N^.MetaTxt^+' still on stack...????');
End
Else
Begin
Remove(NoteList,N);
BringFreeNote(N);
End
End;
End; (* case *)
N:=P;
PrevNote(N,P);
End;
WriteDebugInfo('There are '+W2S(NoteList.Size)+' notes which slurr to next measure');
(* If NoteList.Size>0 Then WriteDebugInfo('First note now has value :'+
B2S(FirstNote(NoteList)^.NoteVal));
*)
(* Clean up the BeamArray and ChordArray too *)
ResetBeamArray(BeamArray);
ResetChordArray(ChordArray);
ResetAccKeys;
End; (* with thistrack *)
CleanUpSlurrArrays
End;
(**************************************************)
Function RestString(ValType : NoteTypes;
Clef : ClefType ) : STRING;
(**************************************************)
Var c1,c2 : CHAR;
Begin
Case Clef of
VIOLIN : Begin c1:='g'; c2:='j'; end;
BASS : Begin c1:='J'; c2:='K'; end;
End;
CASE ValType Of
WH : RestString:='\pause ';
WHP : RestString:='\rlap{\qsk\pt '+c2+'}\pause ';
WHPP : RestString:='\rlap{\qsk\ppt '+c2+'}\pause ';
H : RestString:='\hpause ';
HP : RestString:='\rlap{\qsk\pt '+c2+'}\hpause ';
HPP : RestString:='\rlap{\qsk\ppt '+c2+'}\hpause ';
HPPP : RestString:='\pause ';
Q : RestString:='\soupir ';
QP : RestString:='\pt '+c1+'\soupir ';
QPP : RestString:='\ppt '+c1+'\soupir ';
QPPP : RestString:='\pppt '+c1+'\soupir ';
C : RestString:='\ds ';
CP : RestString:='\pt '+c1+'\ds ';
C3 : RestString:='\ds ';
CPP : RestString:='\ppt '+c1+'\ds ';
CPPP : RestString:='\pppt '+c1+'\ds ';
CC : RestString:='\qs ';
CCP : RestString:='\pt '+c1+'\qs ';
CCPP : RestString:='\ppt '+c1+'\qs ';
CC3 : RestString:='\qs ';
CCC : RestString:='\qs ';
CCCP : RestString:=' ';
CCC3 : RestString:=' ';
CCCC : RestString:=' ';
CCCCP : RestString:=' ';
CCCC3 : RestString:=' ';
End; (* case *)
End; (* RestString *)
(**************************************)
Function Index (value : Byte) : Byte;
(**************************************)
VAR
Modulo,
TmpIndx : Byte;
Okt : ShortInt;
Begin
If Value>127 Then
Begin
Warning('Found a notevalue exceeding 127, replacing with 60 !');
Value:=60;
End;
Okt:=(value-60);
Okt:=Okt div 12;
(* WriteDebugInfo('Index->Okt='+I2S(Okt)); *)
Modulo:=value mod 12;
(* WriteDebugInfo('Index->Modulo='+I2S(Modulo)); *)
TmpIndx:=CPosition+7*Okt;
(* WriteDebugInfo('Index->TmpIndx='+I2S(TmpIndx)); *)
If Value>60 Then
Case modulo of
0 : Index:=TmpIndx;
2 : Index:=TmpIndx+1;
4 : Index:=TmpIndx+2;
5 : Index:=TmpIndx+3;
7 : Index:=TmpIndx+4;
9 : Index:=TmpIndx+5;
11: Index:=TmpIndx+6;
Else
Index:=TmpIndx;
End
Else
Begin
Case modulo of
2 : Index:=TmpIndx-6;
4 : Index:=TmpIndx-5;
5 : Index:=TmpIndx-4;
7 : Index:=TmpIndx-3;
9 : Index:=TmpIndx-2;
11: Index:=TmpIndx-1;
Else
Index:=TmpIndx;
End
End
End; (* Index *)
(************************************************************************)
Function ValueString(value : Byte;
Control : ControlInfo;
VAR AKey : AccKeyType;
ChangeAKey: Boolean ) : STRING;
(************************************************************************)
VAR
Modulo : Byte;
Begin
Modulo:=value mod 12;
(* The Accidental records should be in connection with each track, not with *)
(* the control structure. In that case this function should include the *)
(* track as a parameter. *)
With Control Do
Case modulo of
0 : Case KeySign Of
-7..-6: If (Akey.C=NON) Then
Begin
ValueString:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.C:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
2..8 : If (Akey.C=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.C:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.C<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.C:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
1 : Case KeySign Of
2..8 : If Akey.C=CORRECT Then
Begin
ValueSTring:='{^'+Notes[Index(value-1)]+'}';
If ChangeAKey Then Akey.C:=NON;
End
Else ValueSTring:=Notes[Index(value-1)];
-8..-4: If Akey.D=CORRECT Then
Begin
ValueSTring:='{_'+Notes[Index(value+1)]+'}';
If ChangeAKey Then Akey.D:=NON;
End
Else ValueSTring:=Notes[Index(value+1)];
Else If Akey.C=SHARP Then ValueSTring:=Notes[Index(value-1)]
Else If Akey.D=FLAT Then ValueSTring:=Notes[Index(value+1)]
Else
Case KeySIgn Of
-8..-1 : Begin
ValueSTring:='{_'+Notes[Index(value+1) ]+'}';
If ChangeAKey Then Akey.D:=FLAT;
End;
0..8 : Begin
ValueSTring:='{^'+Notes[Index(value-1) ]+'}';
If ChangeAKey Then Akey.C:=SHARP;
End;
End;
End; (* Case KeySign *)
2 : Case KeySign Of
-8..-4: If (Akey.D=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.D:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
4..8 : If (Akey.D=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.D:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.D<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.D:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
3 : Case KeySign Of
4..8 : If Akey.D=CORRECT Then
Begin
ValueSTring:='{^'+Notes[Index(value-1)]+'}';
If ChangeAKey Then Akey.D:=NON;
End
Else ValueSTring:=Notes[Index(value-1)];
-8..-2: If Akey.E=CORRECT Then
Begin
ValueSTring:='{_'+Notes[Index(value+1)]+'}';
If ChangeAKey Then Akey.E:=NON;
End
Else ValueSTring:=Notes[Index(value+1)];
Else If Akey.D=SHARP Then ValueSTring:=Notes[Index(value-1)]
Else If Akey.E=FLAT Then ValueSTring:=Notes[Index(value+1)]
Else
Case KeySIgn Of
-8..-1 : Begin
ValueSTring:='{_'+Notes[Index(value+1) ]+'}';
If ChangeAKey Then Akey.E:=FLAT;
End;
0..8 : Begin
ValueSTring:='{^'+Notes[Index(value-1) ]+'}';
If ChangeAKey Then Akey.D:=SHARP;
End;
End;
End; (* Case KeySign *)
4 : Case KeySign Of
-7..-2: If (Akey.E=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.E:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
6..8 : If (Akey.E=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.E:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.E<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.E:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
5 : Case KeySign Of
-7 : If (Akey.F=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.F:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
1..8 : If (Akey.F=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.F:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.F<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.F:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
6 : Case KeySign Of
1..8 : If Akey.F=CORRECT Then
Begin
ValueSTring:='{^'+Notes[Index(value-1)]+'}';
If ChangeAKey Then Akey.F:=NON;
End
Else ValueSTring:=Notes[Index(value-1)];
-8..-5: If Akey.G=CORRECT Then
Begin
ValueSTring:='{_'+Notes[Index(value+1)]+'}';
If ChangeAKey Then Akey.G:=NON;
End
Else ValueSTring:=Notes[Index(value+1)];
Else If Akey.F=SHARP Then ValueSTring:=Notes[Index(value-1)]
Else If Akey.G=FLAT Then ValueSTring:=Notes[Index(value+1)]
Else
Case KeySIgn Of
-8..-1 : Begin
ValueSTring:='{_'+Notes[Index(value+1) ]+'}';
If ChangeAKey Then Akey.G:=FLAT;
End;
0..8 : Begin
ValueSTring:='{^'+Notes[Index(value-1) ]+'}';
If ChangeAKey Then Akey.F:=SHARP;
End;
End;
End; (* Case KeySign *)
7 : Case KeySign Of
-7..-5: If (Akey.G=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.G:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
3..8 : If (Akey.G=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.G:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.G<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.G:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
8 : Case KeySign Of
3..8 : If Akey.G=CORRECT Then
Begin
ValueSTring:='{^'+Notes[Index(value-1)]+'}';
If ChangeAKey Then Akey.G:=NON;
End
Else ValueSTring:=Notes[Index(value-1)];
-8..-3: If Akey.A=CORRECT Then
Begin
ValueSTring:='{_'+Notes[Index(value+1)]+'}';
If ChangeAKey Then Akey.A:=NON;
End
Else ValueSTring:=Notes[Index(value+1)];
Else If Akey.G=SHARP Then ValueSTring:=Notes[Index(value-1)]
Else If Akey.A=FLAT Then ValueSTring:=Notes[Index(value+1)]
Else
Case KeySIgn Of
-8..0 : Begin
ValueSTring:='{_'+Notes[Index(value+1) ]+'}';
If ChangeAKey Then Akey.A:=FLAT;
End;
1..8 : Begin
ValueSTring:='{^'+Notes[Index(value-1) ]+'}';
If ChangeAKey Then Akey.G:=SHARP;
End;
End;
End; (* Case KeySign *)
9 : Case KeySign Of
-7..-3: If (Akey.A=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.A:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
5..8 : If (Akey.A=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.A:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.A<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.A:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
10 : Case KeySign Of
5..8 : If Akey.A=CORRECT Then
Begin
ValueSTring:='{^'+Notes[Index(value-1)]+'}';
If ChangeAKey Then Akey.A:=NON;
End
Else ValueSTring:=Notes[Index(value-1)];
-8..-1: If Akey.B=CORRECT Then
Begin
ValueSTring:='{_'+Notes[Index(value+1)]+'}';
If ChangeAKey Then Akey.B:=NON;
End
Else ValueSTring:=Notes[Index(value+1)];
Else If Akey.A=SHARP Then ValueSTring:=Notes[Index(value-1)]
Else If Akey.B=FLAT Then ValueSTring:=Notes[Index(value+1)]
Else
Case KeySIgn Of
-8..0 : Begin
ValueSTring:='{_'+Notes[Index(value+1) ]+'}';
If ChangeAKey Then Akey.B:=FLAT;
End;
1..8 : Begin
ValueSTring:='{^'+Notes[Index(value-1) ]+'}';
If ChangeAKey Then Akey.A:=SHARP;
End;
End;
End; (* Case KeySign *)
11 : Case KeySign Of
-8..-1: If (Akey.B=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.B:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
8 : If (Akey.B=NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.B:=CORRECT;
End
Else
ValueSTring:=Notes[Index(value)];
Else If (Akey.B<>NON) Then
Begin
ValueSTring:='{='+Notes[Index(value) ]+'}';
If ChangeAKey Then Akey.B:=NON;
End
Else
ValueSTring:=Notes[Index(value)];
End; (* case *)
end
End; (* ValueSTring *)
(**************************************************************************)
Function Note2String(ThisNote:NoteRecord;
Clef : ClefType;
VAR AKey : AccKeyType) : STRING;
(***************************************************************************)
VAR
i : Word;
(*------------------------------*)
Function HangOrBang: Char;
(*------------------------------*)
Begin
If ThisNote.Orient=UP Then HangOrBang:='u'
Else HangOrBang:='l';
End;
Begin
With ThisNote DO
Case Event Of
NOTEON,
NOTEOFF :
CASE NoteType Of
WH : Note2String:='\wh '+ValueString(NoteVal,PieceContr,AKey,TRUE);
WHP : Note2String:='\whp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
WHPP : Note2String:='\whpp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
WHPPP : Note2String:='\whppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
H : Note2String:='\h'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HP : Note2String:='\h'+HangOrBang+'p '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HPP : Note2String:='\h'+HangOrBang+'pp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HPPP : Note2String:='\h'+HangOrBang+'ppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
Q : Note2String:='\q'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QP : Note2String:='\q'+HangOrBang+'p '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QPP : Note2String:='\q'+HangOrBang+'pp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QPPP : Note2String:='\q'+HangOrBang+'ppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
C : Note2String:='\c'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CP : Note2String:='\c'+HangOrBang+'p '+ValueString(NoteVal,PieceContr,AKey,TRUE);
C3 : Note2String:='\c'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPP : Note2String:='\c'+HangOrBang+'pp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPPP : Note2String:='\c'+HangOrBang+'ppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CC : Note2String:='\cc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCP : Note2String:='\pt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+'\cc'+
HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CC3 : Note2String:='\cc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCC : Note2String:='\ccc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCP : Note2String:='\pt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+'\ccc'+
HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCC3 : Note2String:='\ccc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCC : Note2String:='\cccc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCCP : Note2String:='\pt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+'\cccc'+
HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCC3 : Note2String:='\cccc'+HangOrBang+' '+ValueString(NoteVal,PieceContr,AKey,TRUE);
End; (* case *)
VOID : Note2String:='';
TXT : Note2String:='\uptext{' + MetaTxt^ +'} ';
REST : Note2String:=RestString(NoteType,Clef);
PEDAL : If Velocity>0 Then Note2String:='\PED'
Else Note2String:='\DEP';
End; (* case *)
End; (* Note2String *)
(**************************************************************)
Function ChordNote2String(ThisNote:NoteRecord;
Clef : ClefType;
VAR AKey : AccKeyType) : STRING;
(**************************************************************)
VAR
i : Word;
Begin
With ThisNote DO
Case Event Of
NOTEON,
NOTEOFF :
CASE NoteType Of
WH : ChordNote2STring:='\zw '+ValueString(NoteVal,PieceContr,AKey,TRUE);
H : ChordNote2STring:='\zh '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HP : ChordNote2STring:='\zhp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HPP : ChordNote2STring:='\zhpp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
HPPP : ChordNote2STring:='\zhppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
Q : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QP : ChordNote2STring:='\zqp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QPP : ChordNote2STring:='\zqpp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
QPPP : ChordNote2STring:='\zqppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
C : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CP : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
C3 : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPP : ChordNote2STring:='\zqpp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPPP : ChordNote2STring:='\zqppp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CC : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCP : ChordNote2STring:='\zqp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CC3 : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCC : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCP : ChordNote2STring:='\zqp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCC3 : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCC : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCCP : ChordNote2STring:='\zqp '+ValueString(NoteVal,PieceContr,AKey,TRUE);
CCCC3 : ChordNote2STring:='\zq '+ValueString(NoteVal,PieceContr,AKey,TRUE);
End; (* case *)
VOID : ChordNote2String:='';
REST : ChordNote2String:=RestString(NoteType,Clef);
TXT : ChordNote2String:='\uptext{' + MetaTxt^ +'}';
PEDAL : If Velocity>0 Then ChordNote2String:='\PED'
Else ChordNote2String:='\DEP';
End;
End; (* ChordNote2String *)
(**************************************************************)
Function BeamNote2String(ThisNote:NoteRecord;
ThisBeam: BeamRecord;
Clef : ClefType;
VAR AKey : AccKeyType) : STRING;
(**************************************************************)
VAR
TmpStr : String[25];
(*------------------------------*)
Function HOrB: Char;
(*------------------------------*)
Begin
If ThisBeam.Orient=UP Then HOrB:='h'
Else HOrB:='b';
End;
(*------------------------------*)
Function BNo: Char;
(*------------------------------*)
VAR Tmp : String;
Begin
Str(ThisBeam.Numb,Tmp);
If Length(Tmp)>1 Then WriteDebugInfo('Warning: found a beam number bigger than 9 !');
Bno:=Tmp[1];
End;
Begin (* BeamNote2String *)
With ThisNote DO
Case Event Of
NOTEON,
NOTEOFF :
CASE NoteType Of
C,C3,
CC,CC3,
CCC,CCC3,
CCCC,
CCCC3 : Tmpstr:='\q'+HOrB+Bno+ValueString(NoteVal,PieceContr,AKey,TRUE);
CP,CCP,
CCCP,
CCCCP : TmpStr:='\pt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+
'\q'+ HOrB+Bno+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPP : TmpStr:='\ppt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+
'\q'+HOrB+Bno+ValueString(NoteVal,PieceContr,AKey,TRUE);
CPPP : TmpStr:='\pppt '+ValueString(NoteVal,PieceContr,AKey,FALSE)+
'\q'+HOrB+Bno+ValueString(NoteVal,PieceContr,AKey,TRUE);
Else
TmpStr:='??'+HOrB+Bno+ValueString(NoteVal,PieceContr,AKey,TRUE);
WriteDebugInfo('Warning : found a note longer than an eighth note in a beam !');
End; (* case *)
VOID : TmpStr:='';
REST : TmpStr:=RestString(NoteType,Clef);
TXT : TmpStr:='\uptext{' + MetaTxt^ +'}';
PEDAL : If Velocity>0 Then TmpStr:='\PED' Else TmpStr:='\DEP';
End; (* with thisnote *)
BeamNote2String:=TmpStr;
End; (* BeamNote2String *)
(*****************************************************************)
Function InitBeam(ThisBeam : BeamRecord;
ForceZero : Boolean;
VAR AKey : AccKeyType): STRING;
(*****************************************************************)
VAR
TmpStr : String[25];
IndxStr : STring[2];
Begin
With ThisBeam DO
Begin
Str(Numb,IndxStr);
TmpStr:='\i';
Case NoteType Of
C,C3,CP,CPP,CPPP : TmpStr:=TmpStr+'b';
CC,CC3,CCP : TmpSTr:=TmpStr+'bb';
CCC,CCC3,CCCP : TmpSTr:=TmpStr+'bbb';
CCCC,CCCC3,CCCCP : TmpSTr:=TmpStr+'bbbb';
End; (* case *)
If Orient=UP Then TmpStr:=TmpStr+'u'+IndxStr
Else TmpStr:=TmpStr+'l'+IndxStr;
TmpSTr:=TmpStr+ValueString(Pitch,PieceContr,AKey,FALSE)+'{';
(* determine the slope *)
If ForceZero Then
IndxStr:='0'
Else
Case Slope Of
-127..-21 : Str(-9,IndxStr);
-20..-18 : Str(-8,IndxStr);
-17..-15 : Str(-7,IndxStr);
-14..-12 : Str(-6,IndxStr);
-11,-10 : Str(-5,IndxStr);
-9,-8 : Str(-4,IndxStr);
-7,-6 : Str(-3,IndxStr);
-5,-4 : Str(-2,IndxStr);
-3,-2 : Str(-1,IndxStr);
-1..1 : Str(0,IndxStr);
2,3 : Str(1,IndxStr);
4,5 : Str(2,IndxStr);
6,7 : Str(3,IndxStr);
8..9 : Str(4,IndxStr);
10..11 : Str(5,IndxStr);
12..14 : Str(6,IndxStr);
15..17 : Str(7,IndxStr);
18..20 : Str(8,IndxStr);
21..127 : Str(9,IndxStr);
End;
TmpSTr:=TmpStr+IndxStr+'}';
End; (* With *)
WriteDebugInfo('Init beam with '+TmpStr);
InitBeam:=TmpStr
End;(* InitBeam *)
(*****************************************************)
Function PartialBeam(ThisBeam: BeamRecord): STRING;
(*****************************************************)
VAR
IndxStr : STring[2];
TermBeam: String[25];
Begin
Str(ThisBeam.Numb,IndxStr);
TermBeam:='\rlap{\qsk\t';
Case ThisBeam.NoteType Of
C,C3,CP,CPP,CPPP : TermBeam:=TermBeam+'b';
CC,CC3,CCP : TermBeam:=TermBeam+'bb';
CCC,CCC3,CCCP : TermBeam:=TermBeam+'bbb';
CCCC,CCCC3,CCCCP : TermBeam:=TermBeam+'bbbb';
End; (* case *)
If ThisBeam.Orient=UP Then TermBeam:=TermBeam+'u'+IndxStr+'}'
Else TermBeam:=TermBeam+'l'+IndxStr+'}';
WriteDebugInfo('Partial terminate beam with '+TermBeam);
PartialBeam:=TermBeam;
End; (* PartialBeam *)
(*****************************************************)
Function TerminateBeam(ThisBeam: BeamRecord): STRING;
(*****************************************************)
VAR
IndxStr : STring[2];
TermBeam: String[25];
Begin
Str(ThisBeam.Numb,IndxStr);
If ThisBeam.Orient=UP Then TermBeam:='\tbu'+IndxStr
Else TermBeam:='\tbl'+IndxStr;
WriteDebugInfo('Terminating beam with '+TermBeam);
TerminateBeam:=TermBeam;
End; (* Terminate Beam *)
(***********************************************************)
Function ChainBeam(ThisBeam,NextBeam: BeamRecord): STRING;
(***********************************************************)
VAR
IndxStr : STring[2];
TmpStr : String[25];
Begin
If NextBeam.NoteType>ThisBeam.NoteType Then
With NextBeam DO
Begin
Str(Numb,IndxStr);
If NoNotes=1 Then (* there is only one note of higher type in next beam *)
TmpStr:='\t' (* instead of initializing higher order beam we insert *)
Else (* a terminate beam which draws the flags at the back *)
TmpStr:='\n'; (* of the note *)
Case NoteType Of
C,C3,CP,CPP,CPPP : TmpStr:=TmpStr+'b';
CC,CC3,CCP : TmpSTr:=TmpStr+'bb';
CCC,CCC3,CCCP : TmpSTr:=TmpStr+'bbb';
CCCC,CCCC3,CCCCP : TmpSTr:=TmpStr+'bbb';
End; (* case *)
If ThisBeam.Orient=UP Then TmpStr:=TmpStr+'u'+IndxStr
Else TmpStr:=TmpStr+'l'+IndxStr;
End (* With *)
Else
With NextBeam DO
Begin
Str(Numb,IndxStr);
TmpStr:='\t';
Case NoteType Of
C,C3,CP,CPP,CPPP : TmpStr:=TmpStr+'bb';
CC,CC3,CCP : TmpSTr:=TmpStr+'bbb';
CCC,CCC3,CCCP : TmpSTr:=TmpStr+'bbbb';
CCCC,CCCC3,CCCCP : WriteDebugInfo('This cannot happen...!, error in CHaining beam');
End; (* case *)
If ThisBeam.Orient=UP Then TmpStr:=TmpStr+'u'+IndxStr
Else TmpStr:=TmpStr+'l'+IndxStr;
End; (* With *)
WriteDebugInfo('Chaining beam with '+TmpStr);
ChainBeam:=TmpStr;
End; (* ChainBeam *)
(*****************************************************************)
Function InitSlurr(ThisSlurr : SlurrRecord;
VAR AKey : AccKeyType): STRING;
(*****************************************************************)
VAR
TmpStr : String[25];
IndxStr : STring[2];
Begin
With ThisSlurr DO
Begin
Str(Numb1,IndxStr);
TmpStr:='\itenu'+IndxStr+ValueString(NoteVal,PieceContr,AKey,FALSE);
End;
WriteDebugInfo('Init slurr with '+TmpStr);
InitSlurr:=TmpStr
End;(* InitSlurr*)
(***********************************************************)
Function TerminateSlurr(VAR ThisSlurr: SlurrRecord): STRING;
(***********************************************************)
VAR
IndxStr : STring[2];
TmpStr: String[25];
Begin
Str(ThisSlurr.Numb2,IndxStr);
TmpStr:='\tten'+IndxStr;
WriteDebugInfo('Terminating slurr with '+TmpStr);
If ThisSlurr.KindOf=ENDSLUR Then
ThisSlurr.Occupied:=FALSE;
TerminateSlurr:=TmpStr;
End; (* Terminate Slurr *)
(****************************************************)
Procedure FindMeasureParts(ThisMeasure : Word);
(****************************************************)
VAR
ST,ET,TET,DT : MeasureTime;
i,curtrack : Integer;
N,P,Q : NoteRecPoint;
Done,
PartEmpty : Boolean;
t1,t2 : Longint;
Begin
For curtrack:=1 to ntracks do
With TrackArray[curtrack] Do
Begin
WriteDebugInfo('Finding parts in track '+I2S(curtrack));
FirstNote(NoteList,N);
Q:=N;
LastNote(NoteList,P);
SetTime(ST,ThisMeasure,0);
SetTime(ET,ThisMeasure,PieceContr.TicksPerMeasure);
SetTime(DT,0,PieceContr.PartTime);
AddTime(ST,DT,TET);
If N=P Then
Begin
WriteDebugInfo('Only one event in this track and measure ');
Case N^.Event Of
NOTEON,NOTEOFF : WriteDebugInfo('Note '+B2S(N^.NoteVal));
REST : WriteDebugInfo('Rest of type '+I2S(Ord(N^.NoteType)));
TXT : WriteDebugInfo('Text : '+N^.MetaTxt^);
VOID : WriteDebugInfo('Void event ');
PEDAL : WriteDebugInfo('Pedal event');
End;
Case N^.Event Of
NOTEON,
NOTEOFF,
TXT : Begin
PartStart[1]:=N; PartEnd[1]:=N;
For i:=2 to PieceContr.nparts Do
Begin
(* Reset further starts and ends..., but why here ... ? *)
PartStart[i]:=NIL; PartEnd[i]:=NIL;
End;
End;
REST : Begin
For i:=1 to PieceContr.nparts Do
Begin
PartStart[i]:=NIL; PartEnd[i]:=NIL;
End;
i:=PieceContr.nparts div 2;
PartStart[i]:=N; PartEnd[i]:=N;
End;
VOID : Begin
For i:=1 to PieceContr.nparts Do
Begin
PartStart[i]:=NIL; PartEnd[i]:=NIL;
End;
End;
End; (* case *)
End
Else
Begin (* N<>P *)
For i:=1 to PieceContr.nparts do
Begin
WriteDebugInfo('In part '+I2S(i) +' following events:');
PartEmpty:=TRUE;
PartStart[i]:=NIL;
PartEnd[i]:=NIL;
Done:=FALSE;
Begin
t1:=TimeDiff(ST,N^.StartTime);
t2:=TimeDiff(TET,N^.StartTime);
(* does not stop at end of measure *)
While (t1<=0) AND (t2>0) AND NOT Done Do
Begin
Case PartEmpty Of
TRUE : Begin
PartStart[i]:=N; PartEnd[i]:=N;
PartEmpty:=FALSE;
End;
FALSE: PartEnd[i]:=N;
End; (* case *)
Case N^.Event Of
NOTEON,NOTEOFF : WriteDebugInfo('Note '+B2S(N^.NoteVal));
REST : WriteDebugInfo('Rest of type '+I2S(Ord(N^.NoteType)));
TXT : WriteDebugInfo('Text : '+N^.MetaTxt^);
(* VOID : Warning('Whoops, a void event in part....'); *)
End;
NextNote(N,N);
If N=Q Then Done:=TRUE;
t1:=TimeDiff(ST,N^.StartTime);
t2:=TimeDiff(TET,N^.StartTime)
End; (* while *)
End; (* Else *)
Move(TET,ST,SizeOf(ST));
AddTime(ST,DT,TET);
End; (* for next i *)
End; (* Else: N<>P *)
End; (* with curtrack *)
WriteDebugInfo('Ready finding parts in this measure');
End; (* FindMeasureParts *)
(****************************************************)
Procedure PartCreateMeasure;
(****************************************************)
VAR
N : NoteRecPoint;
i,curtr : integer;
Ms : Array[1..MAXPARTS] Of String;
CurLength,
MaxCnt,
EventCnt : Integer;
MaxCnts : Array[1..MAXPARTS] Of Integer;
BeamsOccured : Boolean;
(*-------------------------------*)
Function Seperator : String;
(*-------------------------------*)
Var TmpStr : String;
Begin
TmpStr:='';
If curtr=ntracks Then { we are at the end of the current range ...}
If ntracks>1 Then
Begin (* curtr=ntracks *)
If (NOT TrackArray[TrackOrder[ntracks]].Skip) AND
(NOT TrackArray[TrackOrder[ntracks-1]].Skip) Then
If TrackArray[TrackOrder[ntracks]].Instrument AND
TrackArray[TrackOrder[ntracks-1]].Instrument Then
TmpStr:='|'
Else
TmpStr:='&'
End
Else
TmpStr:=''
Else
Begin
If curtr=1 Then
Begin (* curtr=1 *)
TmpStr:=''
End
Else
Begin (* curtr>1 & curtr<ntracks *)
If NOT TrackArray[TrackOrder[curtr-1]].Skip Then
Begin
If TrackArray[TrackOrder[curtr]].Instrument AND
TrackArray[TrackOrder[curtr-1]].Instrument Then
TmpStr:='|'
Else
TmpStr:='&'
End;
End;
End;
Seperator:=TmpStr;
End; (* Seperator *)
(*--------------------------------------------------------*)
Function GetNoteStr(VAR ThisTrack : TrackRecord) : String;
(*--------------------------------------------------------*)
Var Astring : String;
j : Integer;
TmpTime : MeasureTime;
Begin
Astring:='';
SetTime(TmpTime,MeasureCount+1,0);
With ThisTrack Do
Begin
IF SLurring Then
Begin
j:=IsSlurred(N,ThisTrack);
If j>0 Then
With SlurrArray[j] Do
Case KindOf Of
STARTSLUR : Begin
Astring:=Astring+InitSlurr(SlurrArray[j],AccKey);
End;
REPEATSLUR: Begin
Astring:=Astring+TerminateSlurr(SlurrArray[j]);
Astring:=Astring+InitSlurr(SlurrArray[j],AccKey);
End;
ENDSLUR : Begin
Astring:=Astring+TerminateSlurr(SlurrArray[j]);
End;
ENd; (* case *)
End; (* slurring *)
If Beam Then
Begin
BeamsOccured:=TRUE;
If N=BeamArray[BeamPt].EndNote Then
If BeamArray[BeamPt].CHain2Next Then
Begin
Astring:=Astring+ChainBeam(BeamArray[BeamPt],
BeamArray[BeamPt+1]);
Inc(BeamPt);
If N=BeamArray[BeamPt].EndNote Then (* end this beam immediately *)
Astring:=Astring+TerminateBeam(BeamArray[BeamPt]);
End
Else
Begin
Astring:=Astring+TerminateBeam(BeamArray[BeamPt]);
End
End (* if beam *)
Else
If N=BeamArray[BeamPt].StartNote Then
Begin
BeamsOccured:=TRUE;
If (BeamArray[BeamPt].NoNotes=1) AND
(BeamArray[BeamPt].CHain2Next) AND
(BeamArray[BeamPt].NoteType>BeamArray[BeamPt+1].NoteType) Then
Begin
Astring:=Astring+InitBeam(BeamArray[BeamPt+1],ForceZeroBeams,AccKey);
Astring:=Astring+PartialBeam(BeamArray[BeamPt]);
Inc(BeamPt);
End
Else
Astring:=Astring+InitBeam(BeamArray[BeamPt],ForceZeroBeams,AccKey);
Beam:=TRUE;
End;
If Chord Then
Begin
If N=ChordArray[ChordPt].EndNote Then
Begin
Chord:=FALSE;
WriteDebugInfo('Hit the end of the chord');
Inc(ChordPt);
If Beam Then
Begin
BeamsOccured:=TRUE;
Astring:=Astring+BeamNote2String(N^,BeamArray[BeamPt],Clef,AccKey);
Inc(EventCnt);
If N=BeamArray[BeamPt].EndNote Then
Begin
Beam:=FALSE;
Inc(BeamPt);
End;
End
Else
Begin
Astring:=Astring+Note2String(N^,Clef,AccKey);
Inc(EventCnt);
End
End
Else
Astring:=Astring+ChordNote2String(N^,Clef,AccKey);
End (* If NtArPoint... *)
Else
Begin
If N=ChordArray[ChordPt].StartNote Then
Begin
WriteDebugInfo('Hit start of chord ');
Chord:=TRUE;
Astring:=Astring+ChordNote2String(N^,Clef,AccKey)
End
Else
If Beam Then
Begin
BeamsOccured:=TRUE;
Astring:=Astring+BeamNote2String(N^,BeamArray[BeamPt],Clef,AccKey);
Inc(EventCnt); BeamsOccured:=TRUE;
If (N=BeamArray[BeamPt].EndNote) AND
(NOT BeamArray[BeamPt].Chain2Next) Then
Begin
Beam:=FALSE;
Inc(BeamPt);
End;
End
Else
Begin
Astring:=Astring+Note2String(N^,Clef,AccKey);
Inc(EventCnt);
End
End; (* Else *)
End; (* With thistrack *)
GetNoteStr:=Astring;
End; (* GetNoteStr *)
Begin (* PartCreateMeasure *)
For i:=1 To ntracks do
With TrackArray[i] Do
Begin
Chord:=FALSE;
Beam:=FALSE;
ChordPt:=1;
BeamPt:=1;
End;
CurLength:=0;
For i:=1 to PieceContr.nparts Do
Begin
MaxCnts[i]:=0; BeamsOccured:=FALSE;
Ms[i]:='';
For curtr:=ntracks downto 1 do
With TrackArray[TrackOrder[curtr]] Do
Begin
EventCnt:=0;
If NoteList.Size>MeasureMaxCnt Then MeasureMaxCnt:=NoteList.Size;
If Not Skip Then
Begin
N:=PartStart[i];
If N<>NIL Then
Begin
Ms[i]:=Ms[i]+GetNoteStr(TrackArray[TrackOrder[curtr]]);
While N<>PartEnd[i] Do
Begin
NextNote(N,N);
Ms[i]:=Ms[i]+GetNoteStr(TrackArray[TrackOrder[curtr]]);
End;
End;
End;
Ms[i]:=Ms[i]+Seperator;
If EventCnt>MaxCnts[i] Then MaxCnts[i]:=EventCnt;
End;
(* MaxCnts[i] contains the maximum number of notes in any of the tracks' parts *)
(* we use it to update the total *)
(* cumulative length of the score line *)
If BeamsOccured Then
Begin
Ms[i]:='\NOtes'+Ms[i]+'\enotes\relax';
Inc(CurLength,2*MaxCnts[i]*Elemskip);
End
Else
Case MaxCnts[i] Of
0 : Begin End; (* empty parts are not written ... *)
1..2 : Begin
Ms[i]:='\NOtes'+Ms[i]+'\enotes\relax';
Inc(CurLength,2*(MaxCnts[i])*Elemskip);
ENd;
3..5 : Begin
Ms[i]:='\Notes'+Ms[i]+'\enotes\relax';
Inc(CurLength,Round(1.4*((MaxCnts[i])*Elemskip)));
End;
6..10 : Begin
Ms[i]:='\notes'+Ms[i]+'\enotes\relax';
Inc(CurLength,((MaxCnts[i])*Elemskip));
End;
11..15 : Begin
Ms[i]:='\notes'+Ms[i]+'\enotes\relax';
Inc(CurLength,((MaxCnts[i])*Elemskip));
End;
16..20 : Begin
Ms[i]:='\notes'+Ms[i]+'\enotes\relax';
Inc(CurLength,((MaxCnts[i])*Elemskip));
End;
Else Begin
Ms[i]:='\notes'+Ms[i]+'\enotes\relax';
Inc(CurLength,((MaxCnts[i])*Elemskip));
ENd;
End; (* case *)
If (i>1) Then If NOT BeamsOccured Then
Ms[i]:='\temps'+Ms[i];
End; (* For Next nparts *)
(* All parts are processed, a full measure has been written to disk *)
(* Now we must find out if we have to write a \alapage and \alaligne *)
(* CumLength now contains the length of the total lines *)
If MeasureCount>0 Then
Begin
WriteDebugInfo('Curlength='+I2S(CurLength)+'pt, Cumlength='+I2S(CumLength)+
'pt, Cumheight='+I2S(CumHeight));
If (CumLength+CurLength>=ScoreWidth) Then
Begin
If (CumHeight+ScoreSep+LineHeight*(ntracks-NoOfSkips)>=ScoreHeight) Then
Begin
WriteLn(TexFile,'\alapage');
Inc(NoOfPages);
CumHeight:=200+(ScoreSep+LineHeight*(ntracks-NoOfSkips));
CumLength:=Indent+CurLength;
WriteDebugInfo('so... inserting \alapage');
End
Else
Begin
WriteLn(TexFile,'\alaligne');
Inc(CumHeight,(ScoreSep+LineHeight*(ntracks-NoOfSkips)));
CumLength:=Indent+CurLength;
WriteDebugInfo('so... inserting \aligne');
End
End
Else
Begin
WriteLn(TeXFile,'\barre');
Inc(CumLength,BarIndent+CurLength);
WriteDebugInfo('so... inserting \barre');
End;
End (* If MeasureCount>0 *)
Else
Begin (* MeasureCOunt=0 *)
Inc(CumLength,1*Elemskip+CurLength);
End;
For i:=1 To PieceContr.nparts Do
If MaxCnts[i]>0 Then
Begin
WriteLn(TexFile,Ms[i]);
WriteDebugInfo('Tail of MeasureString : ' + Ms[i]);
End
Else
WriteDebugInfo('Empty part ');
End; (* PartCreateMeasure *)
(**********************************************)
Procedure CheckControls(ThisMsre : Integer);
(**********************************************)
VAR N,P : NoteRecPoint;
Begin
With TrackArray[1] Do (* TrackArray record 1 contains META events *)
If NoteList.Size>0 Then (* we assume that there is only one control *)
Begin (* per measure *)
FirstNote(NoteList,N);
If (N^.StartTime.Measure=ThisMsre) Then
Case N^.Event OF
KEYSIGN,
SIGNATURE : ChangeContext(N);
End; (* case *)
End; (* If *)
End;
(**********************************************)
(* *)
(* MAIN BLOCK *)
(* *)
(**********************************************)
Begin
InstallNewErrorExit;
Notes:='???????????????????ABCDEFGHIJKLMNabcdefghijklmnopqrstuvwxyz???????';
CPosition:=36;
Begin
DisplayLicense;
Initialize;
TmpStr:=ReadString(HlpFilRec,4);
WriteDebugInfo(TmpStr);
IF TmpStr<>'MThd' Then ErrorExit(2);
ALongInt:=ReadLongInt(HlpFilRec);
WriteDebugInfo('HeaderNo='+LI2S(AlongInt));
IF AlongInt<>6 THEN ErrorExit(2);
FileFormat:=ReadInteger(HlpFilRec);
WriteDebugInfo('MidiFile is in format type : '+B2S(FileFormat)); (* this is OK *)
Case FileFormat of
0 : Warning('This is a type 0 MIDI file, no warranties about the result...');
2 : ErrorExit(5);
End;
ntracks:=ReadInteger(HlpFilRec);
WriteDebugInfo(' Found '+I2S(ntracks)+' tracks in this file');
If NoOFSkips>0 Then WriteDebugInfo('Skipping '+B2S(NoOfSkips)+' of them');
If OrderIndex>1 Then If OrderIndex<>ntracks Then ErrorExit(7);
CumHeight:=300+(ScoreSep+LineHeight*(ntracks-NoOfSkips));;
WriteTexHeader;
With PieceContr Do
Begin
Division:=ReadInteger(HlpFilRec);
WriteDebugInfo(' Division : '+I2S(Division));
Num:=4;Den:=2;
TicksPerMeasure:=4*Division*Num div Power(2,Den);
WriteDebugInfo('Ticks per Measure :'+I2S(TicksPerMeasure));
PartTime:=TicksPerMeasure div Num;
nparts:=TicksPerMeasure div PartTime;
Twindow:=Division div 16;
End;
InitFilePosns(ntracks); (* find the starts of the tracks in the file *)
MeasureCount:=-1;
repeat
INC(MeasureCount);
WriteDebugInfo(' starting to read Measure '+W2S(MeasureCount));
Write('['+W2S(MeasureCount)+']');
If (MeasureCount>0) AND (MeasureCount MOD 19 =0) Then WriteLn('');
For curtrack:=1 to ntracks do
Begin
With TrackArray[curtrack] Do
Begin
If NOT EndOfTrackReached(TrackArray[curtrack]) Then
Begin
WriteDebugInfo('Starting to read from track :'+I2S(curtrack));
(* LastNoteOffTime.Measure:=MeasureCount; *) (* to get a correct rest *)
(* LastNoteOffTime.Mpart:=0; *)
QuitTrack:=FALSE;
(* Transfer all spilled events back to the note stack *)
If SpillList.Size>0 Then
WriteDebugInfo('Transfering '+W2S(SpillList.Size)+' notes from spillist');
While SpillList.Size>0 Do
Begin
LastNote(SpillList,N);
Remove(SpillList,N);
Append(NoteList,N);
WriteDebugInfo('Note : '+B2S(N^.NoteVal)+
' from '+W2S(N^.StartTime.Measure)+':'+LI2S(N^.StartTime.MPart)+
' to '+W2S(N^.EndTime.Measure)+':'+LI2S(N^.EndTime.MPart));
If SPillList.Size=0 Then
Begin
If N^.StartTime.Measure>MeasureCount Then
QuitTrack:=TRUE;
ENd;
End;
If (NOT QuitTrack) AND (NOT EndOfTrackRead) Then
Repeat
ReadDeltaTime(TrackArray[curtrack]);
If (CurTime.Measure>MeasureCount+1) OR
((CurTime.Measure=MeasureCount+1) AND
(CurTime.Mpart>QuantTime div 2)) Then
Begin
QuitTrack:=TRUE;
End;
ReadEvent(TrackArray[curtrack]);
INC(SafetyCounter);
until QuitTrack OR EndOfTrackRead;
(* Transfer SpillEvents to SpillList *)
(* only NoteOn can be transferred...*)
(* a NoteOff can be maintained, but *)
(* note must than be slurred to *)
(* next measure *)
(* removing notes to spillist not correct yet.... *)
(* Hans : 24-3-92 *)
If NoteList.Size>0 Then
Begin
SetTime(TempTime,MeasureCount+1,0);
LastNote(NoteList,N);
While (NoteList.Size>0) AND
( TimeDiff(TempTime,N^.StartTime)<=0) Do
Begin
WriteDebugInfo('Transfering note'+B2S(N^.NoteVal)+' to spillist');
Remove(NoteList,N);
Append(SpillList,N);
If NoteList.Size>0 Then
Begin
LastNote(NoteList,N);
WriteDebugInfo('Last note now : '+B2S(N^.NoteVal));
End;
End;
End;
End
Else
WriteDebugInfo('Track '+I2S(curtrack)+' was already empty');
(* see if there was any note at all in the track ... *)
(* this is not OK....????? 26-3-'92 *)
If (NoteList.Size=0) Then
Begin
SetTime(CurTime,MeasureCount,PieceContr.TicksPerMeasure);
InsertRest(TrackArray[curtrack]);
End;
End; (* With TrackArray *)
End; (* For loop curtrack *)
(* Process the current measure in the Track's note arrays *)
WriteLn(TexFile,'%measure ',MeasureCount+1);
(* see if there are any control events to start in this measure *)
CheckControls(MeasureCount);
BeamIndex:=0;
For curtrack:=ntracks downto 1 do
Begin
With TrackArray[curtrack] Do
If (NOT Skip) AND (NoteList.Size>0) Then
Begin
WriteDebugInfo('Start handling events in track :'+I2S(curtrack));
FindNoteTypes(TrackArray[TrackOrder[curtrack]],MeasureCount);
ChordFind(TrackArray[TrackOrder[curtrack]]);
FindSLurrNote(TrackArray[TrackOrder[curtrack]],MeasureCount);
BeamFind(TrackArray[TrackOrder[curtrack]]);
End;
End;
FindMeasureParts(MeasureCount);
PartCreateMeasure;
CleanUpTracks;
until AllTracksRead(ntracks) OR
(SafetyCounter>10000);
WriteLn(TexFile,'\finmorceau');
WriteLn(TexFile,'\bye');
WriteLn('');
WriteLn('Total : '+I2S(NoOfPages)+' pages coded');
end;
end.
